*
* $Id$
*
* $Log: isotpe.F,v $
* Revision 1.1.1.1  2002/06/16 15:18:43  hristov
* Separate distribution  of Geant3
*
* Revision 1.1.1.1  1999/05/18 15:55:21  fca
* AliRoot sources
*
* Revision 1.1.1.1  1995/10/24 10:21:57  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
*-- Author :
      SUBROUTINE ISOTPE(D,LD,KM,RHO,IN,IDICTS,LDICT,E,TSIG,NMED,
     +                  IIN,IIM)
C       THIS ROUTINE DETERMINES WHICH ISOTOPE HAS BEEN STRUCK
C       IN MEDIA NMED
#include "geant321/minput.inc"
#include "geant321/mconst.inc"
#include "geant321/mmicab.inc"
C
      DIMENSION D(*),LD(*),KM(*),RHO(*),IN(*),IDICTS(NNR,NNUC),
     +          LDICT(NNR,NNUC)
      SAVE
C
      R=FLTRNF(0)
      NOA=0
      SUM=0.
#if defined(CERNLIB_MDEBUG)
      DO 10 K=1,NMIX
         IF(KM(K).NE.NMED)GO TO 10
C       DETERMINE ISOTOPE NUMBER
         K1=IN(K)
         K2=K
C       DETERMINE TOTAL CROSS SECTION FOR THIS ISOTOPE
         LS1=IDICTS(1,K1)+LMOX2
         L1=LDICT(1,K1)
         LEN=L1/2
         CALL TBSPLT(D(LS1),E,LEN,X)
         SUM=SUM+X*RHO(K)
         PRINT *,' ISOTPE: K=',K,' RHO=',RHO(K),' Sig=',X*RHO(K),
     +       ' SUM=',SUM,' TSIG=',TSIG,' R=',R
   10 CONTINUE
      SUM = 0.0
#endif
   20 DO 30 K=1,NMIX
         IF(KM(K).NE.NMED)GO TO 30
C       DETERMINE ISOTOPE NUMBER
         K1=IN(K)
         K2=K
C       DETERMINE TOTAL CROSS SECTION FOR THIS ISOTOPE
         LS1=IDICTS(1,K1)+LMOX2
         L1=LDICT(1,K1)
         LEN=L1/2
         CALL TBSPLT(D(LS1),E,LEN,X)
         SUM=SUM+X*RHO(K)
C       CHECK TO SEE IF THIS ISOTOPE WAS HIT
         IF(R.LE.SUM/TSIG)GO TO 40
   30 CONTINUE
C       AN ISOTOPE WAS NOT CHOSEN, TRY AGAIN
      NOA=NOA+1
      IF(NOA.GT.5)GO TO 50
      SUM=0.0
      R=FLTRNF(0)
      GO TO 20
   40 IIN=K1
      IIM=K2
#if defined(CERNLIB_MDEBUG)
      PRINT *,' Isotope chosen : K=',K
#endif
      RETURN
   50 WRITE(IOUT,10000)NMED,TSIG
10000 FORMAT(' MICAP: AN ISOTOPE WAS NOT CHOSEN IN 5 ATTEMPTS IN ',
     +'ROUTINE ISOTPE',/,3X,'MEDIUM=',I5,5X,'MACROSCOPIC XSEC=',
     +1PE12.4)
      WRITE(IOUT,10100)R,SUM,TSIG,X,E,RHO(K2),NMED,K1,K2
10100 FORMAT('0',1X,1P6E12.4,3I10)
      WRITE(6,*) ' CALOR: ERROR in ISOTPE =====> STOP '
      STOP
      END
